Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/ISSUE22/TIMING/PROFIT.PAS

Pascal/Delphi Source File | 1997-02-21 | 9.3 KB | 494 lines

unit PROFIT;

{ This is a unit to permit various profiling strategies }



interface




{ Conditional defines must include definitions for profiling as follows:


    Definition               Action
    ----------------------------------------------------------------
    TMPR                     Causes the timing profiler to be linked
    PrinterPortProfiler      Causes the timing profiler to be linked
    ----------------------------------------------------------------
 }







{ PrinterPort profiler }
{ ---------------------------------------------------------------- }


{ This permits the use of the parallel printer port as a
  program profiling aid. It uses toggling D0 of the printer data to
  indicate program activity without incurring speed or compatibility
  problems. }

{ Port details:
      Data:
         |7|6|5|4|3|2|1|0|  ports 278, 378 (LPT1), 3BC
          | | | | | | | +---- data bit 0, hardware pin 2
          | | | | | | +----- data bit 1, hardware pin 3
          | | | | | +------ data bit 2, hardware pin 4
          | | | | +------- data bit 3, hardware pin 5
          | | | +-------- data bit 4, hardware pin 6
          | | +--------- data bit 5, hardware pin 7
          | +---------- data bit 6, hardware pin 8
          +----------- data bit 7, hardware pin 9


        Port 3BD printer status register   (Parallel Printer Port)

         ª7ª6ª5ª4ª3ª2ª1ª0ª  ports 279, 379 (LPT1), 3BD
          | | | | | | | +---- 1 = time-out
          | | | | | |------- unused
          | | | | +-------- 1 = error,  pin 15
          | | | +--------- 1 = on-line,  pin 13
          | | +---------- 1 = out of paper,  pin 12
          | +----------- 0 = Acknowledge,  pin 10
          +------------ 0 = busy,  pin 11

   All signals relative to ground, pins 18..25 inc.

}

const
 ioAdr1 = $378;
 ioAdr2 = $278;
 ioAdr3 = $3BC;

procedure PPPRInitialise( APortAddress : word );
{ Opens the printer port setting defaults }
procedure PPPRSetAllBits;
{ Sets the port to all data bits = 1 }
procedure PPPRClearAllBits;
{ Sets the port to all data bits = 0 }
procedure PPPRToggleAllBits;
{ Complements all data bits }
procedure PPPRWriteAllBits( APattern : byte );
{ Sets this pattern on the data }
function  bfunc_PPPRBusyIsHigh : boolean;
{ Returns TRUE if the busy input is high }
function  bfunc_PPPRBusyIsLow : boolean;
{ Returns TRUE if the busy input is low }
procedure PPPRSetDefaults;
{ Sets the port into a defined state }

{ End of PrinterPort profiler }
{ ---------------------------------------------------------------- }











{ Timing profiler }
{ ---------------------------------------------------------------- }
procedure TMPROpen( const AFileName : string;
                          AMaxItems : integer );
{ Opens the timing profiler }
procedure TMPRStart;
{ Resets the timing profiler }
procedure TMPRMark( ACode : integer );
{ Marks this profile point }
procedure TMPRClose;
{ Closes the timing profiler }

{ End of Timing profiler }
{ ---------------------------------------------------------------- }







implementation

{$I LibDef.inc}


{$IFDEF TMPR }

  {$IFDEF TargetDelphi}
  uses
  HiResTmr,
  Winprocs,
  WinTypes,
  SysUtils;
  {$ENDIF}

  {$IFDEF TargetDOSMode}
  uses
  HiResTmr,
  Objects;
  {$ENDIF}


{$ENDIF}






{ PrinterPort profiler }
{ ---------------------------------------------------------------- }

{$IFDEF PrinterPortProfiler }


const
 by_PPPRExistingPattern : byte = 0;
 w_PPTAdr : word = ioAdr1;


procedure   WriteIOByte( AData : byte; AAddress : word); assembler;
{$IFDEF Target16Bit}
  asm
  mov dx,AAddress;
  mov al,AData;
  out dx,al
  end;
{$ENDIF}

{$IFDEF Target32Bit}
  asm
  out dx,al
  end;
{$ENDIF}


function ReadIOByte( AAddress : word) : byte; assembler;
{$IFDEF Target16Bit}
  asm
  mov dx,AAddress;
  in al,dx
  end;
{$ENDIF}

{$IFDEF Target32Bit}
  asm
  mov dx,ax
  in al,dx
  end;
{$ENDIF}




procedure PPPRInitialise( APortAddress : word );
{ Opens the printer port setting defaults }
begin
  w_PPTAdr := APortAddress;
  PPPRSetDefaults;
end;


procedure PPPRClearAllBits;
{ Sets the port to all data bits = 0 }
begin
  PPPRWriteAllBits( 0 );
end;

procedure PPPRSetAllBits;
{ Sets the port to all data bits = 1 }
begin
  PPPRWriteAllBits( $FF );
end;


procedure PPPRToggleAllBits;
{ Complements all data bits }
begin
  PPPRWriteAllBits( by_PPPRExistingPattern xor $FF );
end;


procedure PPPRWriteAllBits( APattern : byte );
{ Sets this pattern on the data }
begin
  WriteIOByte( APattern, w_PPTAdr );
  by_PPPRExistingPattern := APattern;
end;


procedure PPPRSetDefaults;
{ Sets the port into a defined state }
begin
  PPPRClearAllBits;
end;


function  bfunc_PPPRBusyIsHigh : boolean;
{ Returns TRUE if the busy input is high }
begin
  bfunc_PPPRBusyIsHigh :=
    (ReadIOByte( w_PPTAdr + 1 {Status reg} ) and $80) <> 0;
end;

function  bfunc_PPPRBusyIsLow : boolean;
{ Returns TRUE if the busy input is low }
begin
  bfunc_PPPRBusyIsLow := not bfunc_PPPRBusyIsHigh;
end;

{$ElSE}


procedure PPPRInitialise;
{ Opens the printer port setting defaults }
begin
end;

procedure PPPRSetAllBits;
{ Sets the port to all data bits = 1 }
begin
end;

procedure PPPRClearAllBits;
{ Sets the port to all data bits = 0 }
begin
end;

procedure PPPRToggleAllBits;
{ Complements all data bits }
begin
end;

procedure PPPRWriteAllBits( APattern : byte );
{ Sets this pattern on the data }
begin
end;

function  bfunc_PPPRBusyIsHigh : boolean;
{ Returns TRUE if the busy input is high }
begin
end;

function  bfunc_PPPRBusyIsLow : boolean;
{ Returns TRUE if the busy input is low }
begin
end;

procedure PPPRSetDefaults;
{ Sets the port into a defined state }
begin
end;




{$ENDIF}



{ End of PrinterPort profiler }
{ ---------------------------------------------------------------- }







{ Timing profiler }
{ ---------------------------------------------------------------- }


{$IFDEF TMPR }

type
  TTMPRRec = record
   i_code  : integer;
   r_Count : TLargeInteger;
  end;

const
 i_TMPRAbsMaxNumItems = 65520 div SizeOf( TTMPRRec );

type
  TTMPRDataArray = array[0..i_TMPRAbsMaxNumItems] of TTMPRRec;
  PTMPRDataArray = ^TTMPRDataArray;

const
  r_TMPRData     : PTMPRDataArray = nil;
  r_TMPRStart    : TLargeInteger = (QuadPart : 0);
  i_TMPRNumItems : integer = 0;
  i_TMPRMaxItems : integer = 0;
  s_TMPRFileName : PString = nil;

procedure TMPROpen( const AFileName : string;
                          AMaxItems : integer );
{ Opens the timing profiler }
begin
  If r_TMPRData <> nil then
    TMPRClose;

  i_TMPRMaxItems := AMaxItems;
  i_TMPRNumItems := 0;
  s_TMPRFileName := NewStr( AFileName );

  { Create the data store }
  GetMem( r_TMPRData, SizeOf( TTMPRRec ) * i_TMPRMaxItems );

  TMPRStart;
end;



procedure TMPRStart;
{ Resets the timing profiler }
begin
  QueryPerformanceCounter( r_TMPRStart );
end;



procedure TMPRMark( ACode : integer );
{ Marks this profile point }
begin
  If (r_TMPRData = nil)
     or (i_TMPRNumItems >= i_TMPRMaxItems) then Exit;

  With r_TMPRData^[ i_TMPRNumItems ] do
    begin
    i_Code  := ACode;
    QueryPerformanceCounter(r_Count);
    end;
  Inc( i_TMPRNumItems );

end;



procedure TMPRClose;
{ Closes the timing profiler }
var
 F                   : text;
 f_CountsPerMS       : double;
 f_OffsetMS          : double;
 f_LastOffsetMS      : double;
 f_DiffMS            : double;

   procedure FormatMark( ACode     : integer;
                         AOffsetMS : double;
                         ADiffMS   : double );
   begin
     Write( F, 'Ref:'        , ACode     : 5 );
     Write( F, ', Abs (ms):' , AOffsetMS : 9 : 4 );
     Write( F, ', Diff (ms):', ADiffMS   : 9 : 4 );
     Writeln( F );
   end;

var
 I : integer;
begin
  If (r_TMPRData = nil)
    or (s_TMPRFileName = nil) then Exit;

  f_CountsPerMS  := r_CountsPerSec.QuadPart / 1000;

  Assign( F, s_TMPRFileName^ );
  Rewrite( F );
  Writeln( F, 'Timing profile dump');
  Writeln( F );


  { Dump the data to the file }
  For I := 0 to i_TMPRNumItems-1 do
   With r_TMPRData^[I] do
    begin
    f_OffsetMS := (r_Count.QuadPart - r_TMPRStart.QuadPart) / f_CountsPerMS;
    If I = 0 then
      f_LastOffsetMS := f_OffsetMS;
    f_DiffMS := f_OffsetMS - f_LastOffsetMS;
    f_LastOffsetMS := f_OffsetMS;
    FormatMark( i_Code,
                f_OffsetMS,
                f_DiffMS );
    end;
  Close( F );

  DisposeStr( s_TMPRFileName );

  { Dispose of the data store }
  FreeMem( r_TMPRData, SizeOf( TTMPRRec ) * i_TMPRMaxItems );
  r_TMPRData := nil;
end;


{$ELSE }




procedure TMPROpen;
begin
end;



procedure TMPRStart;
{ Resets the timing profiler }
begin
end;



procedure TMPRMark( ACode : integer );
{ Marks this profile point }
begin
end;



procedure TMPRClose;
{ Closes the timing profiler }
begin
end;


{$ENDIF }


{ End of Timing profiler }
{ ---------------------------------------------------------------- }










var
  ExitSave : pointer;

   procedure MyExitProc; FAR;
   begin
   end;


begin
  ExitSave := ExitProc;
  ExitProc := @MyExitProc;
end.